home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / slatex / helpers.ss < prev    next >
Text File  |  1993-11-07  |  4KB  |  123 lines
  1. ;helpers.ss
  2. ;SLaTeX Version 1.99
  3. ;Helpers for SLaTeX
  4. ;(c) Dorai Sitaram, Dec. 1991, Rice University
  5.  
  6. (define set-keyword
  7.   (lambda (x)
  8.     ;add token x to the keyword database
  9.     (if (member-token x keyword-tokens) 'skip
  10.     (begin
  11.      (set! constant-tokens (remove-token! x constant-tokens))
  12.      (set! variable-tokens (remove-token! x variable-tokens))
  13.      (set! keyword-tokens (cons x keyword-tokens))))))
  14.  
  15. (define set-constant
  16.   (lambda (x)
  17.     ;add token x to the constant database
  18.     (if (member-token x constant-tokens) 'skip
  19.         (begin
  20.      (set! keyword-tokens (remove-token! x keyword-tokens))
  21.      (set! variable-tokens (remove-token! x variable-tokens))
  22.      (set! constant-tokens (cons x constant-tokens))))))
  23.  
  24. (define set-variable
  25.   (lambda (x)
  26.     ;add token x to the variable database
  27.     (if (member-token x variable-tokens) 'skip
  28.         (begin
  29.      (set! keyword-tokens (remove-token! x keyword-tokens))
  30.      (set! constant-tokens (remove-token! x constant-tokens))
  31.      (set! variable-tokens (cons x variable-tokens))))))
  32.  
  33. (define set-special-symbol
  34.   (lambda (x transl)
  35.     ;add token x to the special-symbol database with
  36.     ;the translation transl
  37.     (let ((c (assoc-token x special-symbols)))
  38.       (if c (set-cdr! c transl)
  39.       (set! special-symbols
  40.         (cons (cons x transl) special-symbols))))))
  41.  
  42. (define unset-special-symbol
  43.   (lambda (x)
  44.     ;disable token x's special-symbol-hood
  45.     (set! special-symbols
  46.       (rem! (lambda (c) (token=? (car c) x)) special-symbols))))
  47.  
  48. (define texify
  49.   (lambda (s)
  50.     ;create a tex-suitable string out of token s
  51.     (list->string (texify-aux s))))
  52.  
  53. (define texify-data
  54.   (lambda (s)
  55.     ;create a tex-suitable string out of the data token s
  56.     (let loop ((l (texify-aux s)) (r '()))
  57.       (if (null? l) (list->string (reverse! r))
  58.     (let ((c (car l)))
  59.       (loop (cdr l)
  60.         (if (char=? c #\-) (append! (list #\$ c #\$) r)
  61.           (cons c r))))))))
  62.  
  63. (define texify-aux
  64.   (let* ((arrow (string->list "-$>$"))
  65.      (arrow-lh (length arrow)))
  66.     (lambda (s)
  67.       ;return the list of tex characters corresponding to token s
  68.       (let* ((sl (string->list s))
  69.          ;some extra context-sensitive prettifying could go here?!
  70.          (texified-sl
  71.            (append-map! (lambda (c) (string->list (tex-analog c)))
  72.          sl)))
  73.     (ormapcdr
  74.       (lambda (d)
  75.         (if (list-prefix? arrow d)
  76.           (let ((to (string->list "$\\to$")))
  77.         (set-car! d (car to))
  78.         (set-cdr! d (append (cdr to)
  79.                   (list-tail d arrow-lh)))))
  80.         #f)
  81.       texified-sl)
  82.     texified-sl))))
  83.  
  84. (define display-begin-sequence
  85.   (lambda (out)
  86.     (display* out "\\" *code-env-spec* "%" eoln)))
  87.  
  88. (define display-end-sequence
  89.   (lambda (out)
  90.     (display* out "\\end" *code-env-spec* "{}")))
  91.  
  92. (define display-tex-char
  93.   (lambda (c p)
  94.     (display (if (char? c) (tex-analog c) c) p)))
  95.  
  96. (define display-space
  97.   (lambda (s p)
  98.     (cond ((eq? s &plain-space) (display #\space p))
  99.       ((eq? s &init-plain-space) (display #\space p))
  100.       ((eq? s &init-space) (display "\\HL " p))
  101.       ((eq? s &paren-space) (display "\\PRN " p))
  102.       ((eq? s &bracket-space) (display "\\BKT " p))
  103.       ((eq? s "e-space) (display "\\QUO " p))
  104.       ((eq? s &inner-space) (display "\\ " p)))))
  105.  
  106. (define display-tab
  107.   (lambda (tab p)
  108.     (cond ((eq? tab &set-tab) (display "\\=" p))
  109.       ((eq? tab &move-tab) (display "\\>" p)))))
  110.  
  111. (define display-notab
  112.   (lambda (notab p)
  113.     (cond ((eq? notab &begin-string) (display "\\dt{" p))
  114.       ((eq? notab &end-string) (display "}" p)))))
  115.  
  116. (define display-token
  117.   (lambda (s typ p)
  118.     (cond ((eq? typ 'syntax) (display* p "\\sy{" (texify s) #\}))
  119.       ((eq? typ 'variable) (display* p "\\va{" (texify s) #\}))
  120.       ((eq? typ 'constant) (display* p "\\cn{" (texify s) #\}))
  121.       ((eq? typ 'data) (display* p "\\dt{" (texify-data s) #\}))
  122.       (else (lerror 'display-token)))))
  123.